home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / emulator / bsvc-1.000 / bsvc-1 / bsvc-1.0.4 / src / UI / BtkFileSelector.tk < prev    next >
Text File  |  1995-07-26  |  19KB  |  526 lines
  1. ###############################################################################
  2. # $Id: BtkFileSelector.tk,v 1.2 1995/06/30 17:17:57 bmott Exp $
  3. ###############################################################################
  4. # BtkFileSelector.tk - File Selector Widget for Tk
  5. #
  6. #   Use the procedure BtkFileSelector to open a file selector widget.  The
  7. #   procedure accepts the following switches:
  8. #
  9. #     -in <window>      creates the file selector as a child of the window
  10. #     -filter <*.setup> Sets the filter to the given string
  11. #     -text <message>   Message displayed at the top of the file selector 
  12. #
  13. # Copyright (c) 1994 
  14. # Bradford W. Mott
  15. # September 1,1994
  16. ###############################################################################
  17. # $Log: BtkFileSelector.tk,v $
  18. # Revision 1.2  1995/06/30  17:17:57  bmott
  19. # Changed font resources and made the file selector's size depend on
  20. # its parent's size
  21. #
  22. # Revision 1.1  1994/09/13  23:30:03  bmott
  23. # Initial revision
  24. #
  25. #
  26. ###############################################################################
  27.  
  28. set btkFileSelector(path)      [pwd]
  29.  
  30. option add "*btkFileSelector*Font" "-*-helvetica-medium-r-normal--*-120-*-*-*-*-iso8859-*" 40
  31. option add "*btkFileSelector*label*Font" "-*-helvetica-bold-r-normal--*-120-*-*-*-*-iso8859-*" 40
  32. option add "*btkFileSelector*Foreground" "black" 40
  33. option add "*btkFileSelector*Background" "gray80" 40
  34. option add "*btkFileSelector*activeForeground" "black" 40
  35. option add "*btkFileSelector*activeBackground" "gray65" 40
  36. option add "*btkFileSelector*scrollbar*foreground" "gray80" 40
  37. option add "*btkFileSelector*scrollbar*activeForeground" "gray65" 40
  38. option add "*btkFileSelector*selectForeground" "black" 40
  39. option add "*btkFileSelector*selectBackground" "gray65" 40
  40.  
  41.  
  42. ###############################################################################
  43. # Fill the selector's listbox with the files in the current directory
  44. ###############################################################################
  45. proc BtkFileSelectorUpdate {window} {
  46.   global btkFileSelector
  47.  
  48.   ## Change the mouse pointer to the watch
  49.   $window configure -cursor watch
  50.  
  51.   ## Tell tk to update the screen
  52.   update idletasks
  53.  
  54.   ## Get the filter and path
  55.   set filter $btkFileSelector(filter)
  56.   set path $btkFileSelector(path)
  57.  
  58.   ## Update the filter entry field
  59.   $window.filter.entry delete 0 end
  60.   $window.filter.entry insert end $filter
  61.   BtkFileSelectorEntryAlign $window.filter.entry end
  62.  
  63.   ## Update the path entry field
  64.   $window.path.entry delete 0 end
  65.   $window.path.entry insert end $path
  66.   BtkFileSelectorEntryAlign $window.path.entry end
  67.  
  68.   ## Get a list of all of the files in the current directory
  69.   if {$btkFileSelector(allFiles) == "yes"} {
  70.     set files [glob -nocomplain $path/.* $path/*]
  71.     set files [lrange $files 2 end]
  72.   } else {
  73.     set files [glob -nocomplain $path/*]
  74.   }
  75.  
  76.   ## Start with an empty file list
  77.   set filelist ""
  78.  
  79.   ## Build the rest of the file list
  80.   foreach i $files {
  81.     set file [file tail $i]
  82.  
  83.     ## Make sure file really exists (This is for wierd file systems like AFS)
  84.     if {[file exists "$i"] == 1} {
  85.       if {[file isdirectory "$i"] == 1} { 
  86.         lappend filelist "$file/"
  87.       } else { 
  88.         if {[string match $filter $file] == 1} {
  89.           lappend filelist "$file"
  90.         }
  91.       }
  92.     }
  93.   }
  94.  
  95.   ## Sort the file list
  96.   set filelist [lsort $filelist] 
  97.  
  98.   ## Add the parent directory to the top of the list if we're not at the root
  99.   if {$btkFileSelector(path) != ""} {
  100.     set filelist [linsert $filelist 0 "../"]
  101.   }
  102.  
  103.   ## Clear the listbox
  104.   $window.selection.listbox delete 0 end
  105.  
  106.   ## Put the file list in the listbox
  107.   foreach i $filelist {
  108.     $window.selection.listbox insert end "$i"
  109.   }
  110.  
  111.   ## Change the mouse pointer back to the default
  112.   $window configure -cursor {}
  113.  
  114.   ## Tell tk to update the screen
  115.   update idletasks
  116. }
  117.  
  118.  
  119. ###############################################################################
  120. ## Process a click event on a file
  121. ###############################################################################
  122. proc BtkFileSelectorFileClicked {window y} {
  123.   global btkFileSelector
  124.  
  125.   ## Get the listbox item nearest the y coordinate
  126.   set nearest [$window nearest $y]
  127.  
  128.   if {$nearest >= 0} {
  129.     $window select from $nearest
  130.     $window select to $nearest
  131.  
  132.     set file [$window get $nearest]
  133.     if {[regexp {^.*/$} $file] == 0} {
  134.       ## Update the filename entry field
  135.       $btkFileSelector(baseWindow).filename.entry delete 0 end
  136.       $btkFileSelector(baseWindow).filename.entry insert end $file
  137.     }
  138.   }
  139. }
  140.  
  141. ###############################################################################
  142. ## Process a double click event on a file
  143. ###############################################################################
  144. proc BtkFileSelectorFileDoubleClicked {window y} {
  145.   global btkFileSelector
  146.  
  147.   ## Get the path
  148.   set path $btkFileSelector(path)
  149.  
  150.   ## Get the listbox item nearest the y coordinate
  151.   set nearest [$window nearest $y]
  152.   if {$nearest >= 0} {
  153.     set file [$window get $nearest]
  154.     set filespec $path/$file
  155.   
  156.     ## If the file is a directory then try to change directories
  157.     if {[regexp {^.*/$} $file] == 1} {
  158.  
  159.       ## See if we should move to the parent directory
  160.       if {$file == "../"} {
  161.         set filespec [file dirname [string trimright $path '/']]/
  162.       } 
  163.  
  164.       if {([file executable $path/$file]==1)&&([file readable $path/$file]==1)} {
  165.  
  166.         ## Update the path
  167.         set btkFileSelector(path) [string trimright $filespec '/']
  168.  
  169.         BtkFileSelectorUpdate $btkFileSelector(baseWindow)
  170.       } else {
  171.  
  172.         ## Get the current color of the background
  173.         set current [lindex [$window configure -background] 4]
  174.  
  175.         ## Change the background to black 
  176.         $window configure -background Black
  177.  
  178.         ## Tell tk to update the screen
  179.         update idletasks
  180.  
  181.         ## Wait 
  182.         after 50
  183.  
  184.         ## Restore the background
  185.         $window configure -background $current
  186.  
  187.         ## Tell tk to update the screen
  188.         update idletasks
  189.       }
  190.     } else {
  191.       BtkFileSelectorFileSelected
  192.     }
  193.   }
  194. }
  195.  
  196. ###############################################################################
  197. ## Handle the Okay button
  198. ###############################################################################
  199. proc BtkFileSelectorFileSelected {} {
  200.   global btkFileSelector
  201.  
  202.   ## Get the selected file from the listbox
  203.   set file [$btkFileSelector(baseWindow).filename.entry get]
  204.   if {$file == ""} { return }
  205.  
  206.   set btkFileSelector(filespec) $btkFileSelector(path)/$file
  207.   destroy $btkFileSelector(baseWindow)
  208. }
  209.  
  210. ###############################################################################
  211. ## Handle the Cancel button
  212. ###############################################################################
  213. proc BtkFileSelectorCanceled {} {
  214.   global btkFileSelector
  215.  
  216.   set btkFileSelector(filespec) ""
  217.   destroy $btkFileSelector(baseWindow)
  218. }
  219.  
  220. ###############################################################################
  221. ## Set the "common" bindings for the entry widgets
  222. ###############################################################################
  223. proc BtkFileSelectorSetEntryBindings { window } {
  224.   global btkFileSelector
  225.  
  226.   ## See if the entry needs to be added to the list of entry widgets
  227.   if {[lsearch -exact $btkFileSelector(entryList) $window] == -1} {
  228.     lappend btkFileSelector(entryList) $window
  229.   }
  230.  
  231.   bind $window <Left> "BtkFileSelectorEntryCursorPositionChange $window -1"
  232.   bind $window <Right> "BtkFileSelectorEntryCursorPositionChange $window 1"
  233.   bind $window <Tab> "BtkFileSelectorNextEntry"
  234. }
  235.  
  236. ###############################################################################
  237. ## Move the focus to the next entry widget
  238. ###############################################################################
  239. proc BtkFileSelectorNextEntry {} {
  240.   global btkFileSelector
  241.  
  242.   ## Get the current focus window path
  243.   set current [focus]
  244.  
  245.   set currentIndex [lsearch -exact $btkFileSelector(entryList) $current]
  246.   if {$currentIndex == -1} {
  247.     set current [lindex $btkFileSelector(entryList) 0]
  248.   } else {
  249.     set i [expr $currentIndex + 1]
  250.     if {$i >= [llength $btkFileSelector(entryList)]} {
  251.       set i 0
  252.     }
  253.     set current [lindex $btkFileSelector(entryList) $i]
  254.   }
  255.  
  256.   ## Change the entry focus
  257.   catch {focus $current}
  258. }
  259.  
  260. ###############################################################################
  261. ## Change the position of the insertion cursor in the given entry widget
  262. ###############################################################################
  263. proc BtkFileSelectorEntryCursorPositionChange {window offset} {
  264.   global btkFileSelector
  265.  
  266.   set pos [$window index insert]
  267.   incr pos $offset
  268.   if {$pos < 0} {
  269.     set pos 0
  270.   }
  271.   $window icursor $pos
  272.  
  273.   ## Move the cursor into view
  274.   BtkFileSelectorEntryAlign $window insert
  275. }
  276.  
  277. ###############################################################################
  278. ## Tell the entry widget to align the indexed character into view
  279. ###############################################################################
  280. proc BtkFileSelectorEntryAlign { window index } {
  281.  
  282.   set c [$window index $index]
  283.  
  284.   set left [$window index @0]
  285.   if {$left >= $c} {
  286.     if {$c > 0} {
  287.       $window view [expr $c-1]
  288.     } else {
  289.       $window view $c                                                          
  290.     }
  291.     return
  292.   } 
  293.                                                                           
  294.   set x [expr [winfo width $window] - [lindex [$window config -bd] 4] - 1]
  295.   while {([$window index @$x] < $c) && ($left < $c)} {
  296.       set left [expr $left+1]
  297.       $window view $left
  298.   }                                                                           
  299. }
  300.  
  301. ###############################################################################
  302. ## Try to change the path to whatever is in the path entry widget
  303. ###############################################################################
  304. proc BtkFileSelectorSetPath {} {
  305.   global btkFileSelector
  306.  
  307.   ## Get the path from the entry widget
  308.   set path [string trimright [$btkFileSelector(baseWindow).path.entry get] '/']
  309.  
  310.   ## Make sure it's a valid path
  311.   if {([file executable $path/]==1)&&([file readable $path/]==1)} {
  312.     set btkFileSelector(path) $path
  313.     BtkFileSelectorUpdate $btkFileSelector(baseWindow)
  314.   } else {
  315.     ## Update the path entry field
  316.     $btkFileSelector(baseWindow).path.entry delete 0 end
  317.     $btkFileSelector(baseWindow).path.entry insert end $btkFileSelector(path)
  318.  
  319.     ## Right align the view
  320.     BtkFileSelectorEntryAlign $btkFileSelector(baseWindow).path.entry insert
  321.   }
  322. }
  323.  
  324.  
  325. ###############################################################################
  326. ## Try to change the filter to whatever is in the filter entry widget
  327. ###############################################################################
  328. proc BtkFileSelectorSetFilter {} {
  329.   global btkFileSelector
  330.  
  331.   ## Get the path from the entry widget
  332.   set filter [$btkFileSelector(baseWindow).filter.entry get]
  333.  
  334.   ## Make sure there is a filter
  335.   if {$filter == ""} { set filter "*" }
  336.  
  337.   set btkFileSelector(filter) $filter
  338.  
  339.   BtkFileSelectorUpdate $btkFileSelector(baseWindow)
  340. }
  341.  
  342.  
  343. ###############################################################################
  344. # Popup a file selector and wait for the user to select something
  345. ###############################################################################
  346. proc BtkFileSelector args {
  347.   global btkFileSelector
  348.  
  349.   ## Clear the entry "next" list
  350.   set btkFileSelector(entryList) ""  
  351.   ## Set the return value to nothing
  352.   set btkFileSelector(filespec) ""
  353.   ## Default Message
  354.   set btkFileSelector(message) "Files:"
  355.   ## Default to creating a toplevel window
  356.   set btkFileSelector(parentWindow) "root"
  357.   ## Default Filter
  358.   set btkFileSelector(filter) "*"
  359.  
  360.   ## Parse the argument list
  361.   for {set t 0} {$t < [llength $args]} {incr t} {
  362.     set arg [lindex $args $t]
  363.     if {$arg == "-text"} {
  364.       incr t
  365.       set btkFileSelector(message) [lindex $args $t]
  366.     } elseif {$arg == "-in"} {
  367.       incr t
  368.       if {[lindex $args $t] == "."} {
  369.         set btkFileSelector(parentWindow) ""
  370.       } else {
  371.         set btkFileSelector(parentWindow) [lindex $args $t]
  372.       }
  373.     } elseif {$arg == "-filter"} {
  374.       incr t
  375.       set btkFileSelector(filter) [lindex $args $t]
  376.     } else {
  377.       tkerror "Incorrect Arguments to BtkFileSelector!"
  378.       return
  379.     }
  380.   } 
  381.  
  382.   ## Create a toplevel window or a frame to hold the selector in
  383.   if {$btkFileSelector(parentWindow) == "root"} {
  384.     set btkFileSelector(baseWindow) ".btkFileSelector"
  385.     set btkFileSelector(parentWindow) ".btkFileSelector"
  386.  
  387.     toplevel $btkFileSelector(baseWindow) -borderwidth 4
  388.  
  389.     wm geometry $btkFileSelector(baseWindow) 375x342
  390.     wm title $btkFileSelector(baseWindow) "File Selector"
  391.   } else {
  392.     ## Get my parent's width and height
  393.     if {$btkFileSelector(parentWindow) == ""} {
  394.       scan [winfo geometry .] "%dx%d" parentWidth parentHeight
  395.     } else {
  396.       scan [winfo geometry $btkFileSelector(parentWindow)] "%dx%d" parentWidth parentHeight
  397.     }
  398.  
  399.     ## Calculate size of my frame based on my parent's size
  400.     if {$parentWidth > 375} {
  401.       set myWidth 375
  402.     } else {                                                                    
  403.       set myWidth [expr $parentWidth - 20]                                      
  404.     }                                                                           
  405.  
  406.     if {$parentHeight > 350} {                                                
  407.       set myHeight 350                                                          
  408.     } else {                                                                    
  409.       set myHeight [expr $parentHeight - 20]                                    
  410.     }                                                                           
  411.  
  412.     ## Create my frame
  413.     set btkFileSelector(baseWindow) \
  414.         "$btkFileSelector(parentWindow).btkFileSelector"
  415.  
  416.     frame $btkFileSelector(baseWindow) -borderwidth 5 -relief ridge \
  417.       -height $myHeight -width $myWidth
  418.     place $btkFileSelector(baseWindow) -relx 0.5 -rely 0.5 -anchor center 
  419.  
  420.     ## Turn off geometry propagation for the packer
  421.     pack propagate $btkFileSelector(baseWindow) 0
  422.   }
  423.  
  424.   frame $btkFileSelector(baseWindow).path 
  425.     label $btkFileSelector(baseWindow).path.label -text "Path:" -anchor w
  426.     entry $btkFileSelector(baseWindow).path.entry -relief sunken 
  427.     BtkFileSelectorSetEntryBindings $btkFileSelector(baseWindow).path.entry
  428.     bind $btkFileSelector(baseWindow).path.entry \
  429.         <Return> "BtkFileSelectorSetPath"
  430.     pack $btkFileSelector(baseWindow).path.label -side left 
  431.     pack $btkFileSelector(baseWindow).path.entry -side left -fill x -expand 1 
  432.  
  433.   frame $btkFileSelector(baseWindow).filename 
  434.     label $btkFileSelector(baseWindow).filename.label \
  435.         -text "File name:" -anchor w
  436.     entry $btkFileSelector(baseWindow).filename.entry -relief sunken 
  437.     BtkFileSelectorSetEntryBindings $btkFileSelector(baseWindow).filename.entry
  438.     bind $btkFileSelector(baseWindow).filename.entry \
  439.         <Return> "BtkFileSelectorFileSelected"
  440.     pack $btkFileSelector(baseWindow).filename.label -side left 
  441.     pack $btkFileSelector(baseWindow).filename.entry -side left \
  442.         -fill x -expand 1 
  443.  
  444.   frame $btkFileSelector(baseWindow).filter 
  445.     label $btkFileSelector(baseWindow).filter.label -text "Filter:" -anchor w
  446.     entry $btkFileSelector(baseWindow).filter.entry -relief sunken -width 10
  447.     BtkFileSelectorSetEntryBindings $btkFileSelector(baseWindow).filter.entry
  448.     bind $btkFileSelector(baseWindow).filter.entry \
  449.         <Return> "BtkFileSelectorSetFilter"
  450.     checkbutton $btkFileSelector(baseWindow).filter.all \
  451.         -text "Show all files" -offvalue "no" -onvalue "yes"  \
  452.         -variable btkFileSelector(allFiles) \
  453.         -command {BtkFileSelectorUpdate $btkFileSelector(baseWindow)}
  454.  
  455.     pack $btkFileSelector(baseWindow).filter.label -side left 
  456.     pack $btkFileSelector(baseWindow).filter.entry -side left -fill x \
  457.         -expand 1 -padx 4
  458.     pack $btkFileSelector(baseWindow).filter.all -side left
  459.  
  460.   frame $btkFileSelector(baseWindow).selection
  461.     label $btkFileSelector(baseWindow).selection.label \
  462.         -text $btkFileSelector(message)
  463.     scrollbar $btkFileSelector(baseWindow).selection.scrollbar \
  464.         -relief sunken -orient vertical \
  465.         -command "$btkFileSelector(baseWindow).selection.listbox yview"
  466.     listbox $btkFileSelector(baseWindow).selection.listbox \
  467.         -relief sunken -geometry 20x4 \
  468.         -yscroll "$btkFileSelector(baseWindow).selection.scrollbar set"
  469.     tk_listboxSingleSelect $btkFileSelector(baseWindow).selection.listbox
  470.     bind $btkFileSelector(baseWindow).selection.listbox <Double-ButtonRelease-1> \
  471.         "BtkFileSelectorFileDoubleClicked %W %y"
  472.     bind $btkFileSelector(baseWindow).selection.listbox <ButtonPress-1> \
  473.         "BtkFileSelectorFileClicked %W %y" 
  474.     bind $btkFileSelector(baseWindow).selection.listbox <Button1-Motion> \
  475.         "BtkFileSelectorFileClicked %W %y" 
  476.  
  477.     pack $btkFileSelector(baseWindow).selection.label \
  478.         -side top -anchor w -fill x
  479.     pack $btkFileSelector(baseWindow).selection.scrollbar \
  480.         -side left -fill y
  481.     pack $btkFileSelector(baseWindow).selection.listbox \
  482.         -side left -fill both -expand 1
  483.  
  484.  
  485.   frame $btkFileSelector(baseWindow).button
  486.     button $btkFileSelector(baseWindow).button.okay \
  487.         -text "Okay" -command "BtkFileSelectorFileSelected"
  488.     button $btkFileSelector(baseWindow).button.filter \
  489.         -text "Filter" -command "BtkFileSelectorSetFilter"
  490.     button $btkFileSelector(baseWindow).button.cancel \
  491.         -text "Cancel" -command "BtkFileSelectorCanceled"
  492.  
  493.     pack $btkFileSelector(baseWindow).button.okay \
  494.         -side left -fill x -expand 1
  495.     pack $btkFileSelector(baseWindow).button.filter \
  496.         -side left -fill x -expand 1 -padx 4
  497.     pack $btkFileSelector(baseWindow).button.cancel \
  498.         -side left -fill x -expand 1
  499.  
  500.   pack $btkFileSelector(baseWindow).selection \
  501.       -side top -padx 4 -pady 2 -fill both -expand 1
  502.   pack $btkFileSelector(baseWindow).path \
  503.       -side top -padx 4 -fill x
  504.   pack $btkFileSelector(baseWindow).filename \
  505.       -side top -padx 4 -fill x
  506.   pack $btkFileSelector(baseWindow).filter \
  507.       -side top -padx 4 -fill x
  508.   pack $btkFileSelector(baseWindow).button \
  509.       -side top -padx 4 -pady 7 -fill x
  510.  
  511.  
  512.   ## Update the file selector's file list
  513.   BtkFileSelectorUpdate $btkFileSelector(baseWindow)
  514.  
  515.   ## Make this a modal dialog
  516.   tkwait visibility $btkFileSelector(baseWindow)
  517.   while {[catch {grab set $btkFileSelector(baseWindow)}] == 1} {}
  518.   tkwait window $btkFileSelector(baseWindow)
  519.  
  520.   ## Tell tk to update the screen (i.e. remove the file selector window)
  521.   update idletasks
  522.  
  523.   return $btkFileSelector(filespec)
  524. }
  525.  
  526.